home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Collections: Franz PD
/
Franz PD Disk #193 (1992)(Rhein-Sieg-Soft).zip
/
Franz PD Disk #193 (1992)(Rhein-Sieg-Soft).adf
/
GFA.Anwendung
/
KALENDER.LST
< prev
next >
Wrap
File List
|
1992-09-14
|
5KB
|
161 lines
REM *********************************
REM * Kalender V 1.0 *
REM * © 1992 by Henry König *
REM * Bornheide 71, 2000 Hamburg 53 *
REM *********************************
init
programmkopf
jahr%=0
WHILE jahr%<1900 OR jahr%>2000
PRINT AT(4,10);"Kalender von welchem Jahr: ";
INPUT jahr$
jahr%=VAL(jahr$)
WEND
PRINT
INPUT " Ausgabe auf den Drucker j/n ";x$
IF UPPER$(x$)="J" THEN
gadr%=4
ENDIF
DIM motage%(12)
DIM tag$(7)
DIM ewt%(12)
DIM uebers$(4)
uebers$(1)="Januar Februar März"
uebers$(2)="April Mai Juni"
uebers$(3)="Juli August September"
uebers$(4)="Oktober November Dezember"
FOR monat%=1 TO 12
READ motage%(monat%)
NEXT monat%
IF jahr%/4=INT(jahr%/4) THEN
motage%(2)=29 ! ist ein Schaltjahr
ENDIF
FOR i%=1 TO 7
READ tag$(i%)
NEXT i%
REM Wochentag des 1.1. berechnen
tage=INT(0.98+365.25*(jahr%-1900))
ewt%(1)=tage-INT((tage-1)/7)*7
REM Wochentag von jeden Monat berechnen
FOR monat%=2 TO 12
sum=ewt%(monat%-1)+motage%(monat%-1)
ewt%(monat%)=sum-INT((sum-1)/7)*7
NEXT monat%
REM Kalender ausgeben
CLS
PRINT SPC(25);"Kalender ";jahr%
PRINT
IF gadr%=4 THEN ! Druckerausgabe
OPEN "O",#4,"PRT:" ! Drucker öffnen
PRINT #4,SPC(25);"Kalender ";jahr%
PRINT #4,
ENDIF
FOR mreihe%=1 TO 4
PRINT
PRINT
PRINT SPC(8);uebers$(mreihe%)
PRINT
IF gadr%=4 THEN
PRINT #4,
PRINT #4,
PRINT #4,SPC(8);uebers$(mreihe%)
PRINT #4,
ENDIF
FOR reihe%=1 TO 7
PRINT tag$(reihe%);
IF gadr%=4 THEN
PRINT #4,tag$(reihe%);
ENDIF
FOR mspalte=1 TO 3
monat%=3*(mreihe%-1)+mspalte
FOR spalte=1 TO 6
dat=spalte*7-6+reihe%-ewt%(monat%)
IF dat<=0 OR dat>motage%(monat%) THEN
dat$=" " ! Datum negativ
ELSE
dat$=RIGHT$(" "+STR$(dat),3)
ENDIF
PRINT dat$;
IF gadr%=4 THEN
PRINT #4,dat$;
ENDIF
NEXT spalte
NEXT mspalte
PRINT
IF gadr%=4 THEN
PRINT #4,
ENDIF
NEXT reihe%
NEXT mreihe%
CLOSE #4
PRINT
PRINT SPC(20);"Ende mit beliebiger Taste";
INPUT x$
CLOSEW #1
CLOSES 1
END
REM Anzahl der Tage je Monat
DATA 31,28,31,30,31,30,31,31,30,31,30,31
REM Kurzform der Wochentage
DATA "Mo","Di","Mi","Do","Fr","Sa","So"
PROCEDURE programmkopf
CLS ! Bildschirm löschen
COLOR 2 ! schwarz
PBOX 1,1,639,22 ! Box zeichnen
COLOR 0 ! grau
PBOX 4,3,636,20 ! Box zeichnen
COLOR 4 ! hellgrau
LINE 8,18,632,18 ! untere Lichtlinien
LINE 632,4,632,18 ! rechte Lichtlinie
LINE 631,5,631,18 ! rechte Lichtlinie
COLOR 2 ! schwarz
LINE 8,4,631,4 ! obere Schatttenlinie
LINE 6,4,6,18 ! linke Schattenlinie
LINE 7,4,7,17 ! linke Schattenlinie
PCOLOR 5,0 ! gelbe Schrift
PRINT AT(28,2);"K a l e n d e r 1.00"
PCOLOR 1,0 ! weiße Schrift
programmfuss
PRINT AT(4,28);"© 1992 by Henry König, Bornheide 71, 2000 Hamburg 53"
RETURN
> PROCEDURE programmfuss ! Anweisungsboxen zeichnen
COLOR 2 ! schwarz
PBOX 1,(27*8)-10,639,(32*8) ! schwarze Box
COLOR 0 ! grau
PBOX 6,(27*8)-7,633,(28*8)+4 ! graue Box
PBOX 6,(29*8)+2,633,(32*8)-4 ! 2. graue Box
COLOR 4 ! hellgrau
BOX 7,(27*8)-7,633,(32*8)-3
LINE 7,(29*8)+2,633,(29*8)+2
LINE 16,(29*8)-6,639-16,(29*8)-6
LINE 16,(29*8)+5,639-16,(29*8)+5
LINE 639-16,(29*8)-6,639-16,(26*8)+4 ! senkrechter Strich
LINE 16,(29*8)+5,16,(31*8)+2 ! senkrechter Strich
COLOR 2 ! schwarz
LINE 7,(32*8)-3,633,(32*8)-3 ! schwarze Linie
LINE 633,(27*8)-7,633,(32*8)-3
LINE 16,(27*8)-4,639-16,(27*8)-4
LINE 16,(31*8)+2,639-16,(31*8)+2
LINE 16,(29*8)-6,16,(26*8)+4 ! senkrechter Strich
LINE 639-16,(29*8)+5,639-16,(31*8)+2 ! senkrechter Strich
RETURN
> PROCEDURE init
breite%=640 ! Screenbreite
hoehe%=256 ! Screenhöhe
ebenen%=3 ! 3 Bitplanes
OPENS 1,0,0,breite%,hoehe%,ebenen%,&H8000
OPENW #1,0,0,breite%,hoehe%,&H18,&H1800,1
farben.setzen ! Farbpalette setzen
RETURN
> PROCEDURE farben.setzen
SETCOLOR 0,5,5,5 ! grau statt blau
SETCOLOR 1,15,15,15 ! weiß bleibt
SETCOLOR 2,0,0,0 ! schwarz erhalten
SETCOLOR 3,15,5,0 ! rot bleibt
SETCOLOR 4,10,10,10 ! hellgrau inverse Farbe im Filerequester
SETCOLOR 5,15,15,0 ! gelb
SETCOLOR 6,0,0,0 ! schwarz = Inverse Farbe im Filerequester
RETURN
REM
REM